home *** CD-ROM | disk | FTP | other *** search
/ Magazyn WWW 1999 July / www_07_1999.iso / prog / mac / alpha / alpha.hqx / Alpha ƒ / Tcl / SystemCode / search.tcl < prev    next >
Text File  |  1999-04-21  |  21KB  |  698 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "search.tcl"
  6.  #                                    created: 13/6/95 {8:56:37 pm} 
  7.  #                                last update: 21/4/1999 {8:03:14 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  #  Description: 
  15.  # 
  16.  # All procedures which deal with search/reg-search/grep type stuff
  17.  # in Alpha.
  18.  # ###################################################################
  19.  ##
  20.  
  21. namespace eval text {}
  22. namespace eval quote {}
  23. namespace eval file {}
  24.  
  25. proc quickFind {} {isearch}
  26. proc reverseQuickFind {} {rsearch}
  27. proc quickFindRegexp {} {regIsearch}
  28.  
  29. #================================================================================
  30. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  31. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  32. #================================================================================
  33. proc greplist {args} {
  34.     global tileLeft tileTop tileWidth tileHeight errorHeight
  35.     
  36.     set recurse [lindex $args 0]
  37.     set word [lindex $args 1]
  38.     set args [lrange $args 2 end]
  39.     
  40.     set num [expr {[llength $args] - 2}]
  41.     set exp [lindex $args $num]
  42.     set arglist [lindex $args [expr {$num + 1}]]
  43.     
  44.     set opened 0
  45.     set cid [scancontext create]
  46.     
  47.     set cmd [lrange $args 0 [expr {$num - 1}]]
  48.     eval scanmatch $cmd {$cid $exp {
  49.     if {!$word || [regexp -nocase -- "(^|\[^a-zA-Z0-9\])${exp}(\[^a-zA-Z0-9\]|\$)" $matchInfo(line)]} {
  50.         if {!$opened} {
  51.         set opened 1
  52.         win::SetProportions
  53.         set w [new -n {* Batch Find *} -m Brws -g $tileLeft $tileTop $tileWidth $errorHeight -tabsize 8]
  54.         insertText "(<cr> to go to match)\r-----\r"
  55.         }
  56.         set l [expr {20 - [string length [file tail $f]]}]
  57.         regsub -all "\t" $matchInfo(line) "  " text
  58.         insertText -w $w "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): ${text}\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t░$f\r"}
  59.     }
  60.     }
  61.     
  62.     foreach f $arglist {
  63.     message [file tail $f]
  64.     if {![catch {set fid [open $f]}]} {
  65.         scanfile $cid $fid
  66.         close $fid
  67.     }
  68.     }
  69.     scancontext delete $cid
  70.     
  71.     if {$opened} {
  72.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  73.     setWinInfo dirty 0
  74.     setWinInfo read-only 1
  75.     }
  76.     message ""
  77. }
  78.  
  79.  
  80. ## 
  81.  # -------------------------------------------------------------------------
  82.  # 
  83.  # "grepfset" --
  84.  # 
  85.  #  args: wordmatch ?-nocase? expression fileset
  86.  #  Obviously we ignore wordmatch
  87.  #  
  88.  #  If the 'Grep' box was set, then the search item is _not_ quoted.
  89.  #  
  90.  #  Non grep searching problems:
  91.  #  
  92.  #  If it wasn't set, then some backslash quoting takes place. 
  93.  #  (The chars: \.+*[]$^ are all quoted)
  94.  #  Unfortunately, this latter case is done incorrectly, so most
  95.  #  non-grep searches which contain a grep-sensitive character fail.
  96.  #  The quoting should use the equivalent of the procedure 'quote::Regfind'
  97.  #  but it doesn't quote () and perhaps other important characters.
  98.  #  
  99.  #  Even worse, if the string contained any '{' it never reaches this
  100.  #  procedure (there must be an internal error due to bad quoting).
  101.  # 
  102.  # -------------------------------------------------------------------------
  103.  ##
  104. proc grepfset {args} {
  105.     set num [expr {[llength $args] - 2}]
  106.     # the 'find' expression
  107.     set exp [lindex $args $num]
  108.     # the fileset
  109.     set fset [lindex $args [expr {$num + 1}]]
  110.     eval greplist 0 [lrange $args 0 [expr {$num-1}]] {$exp [getFileSet $fset]}
  111. }
  112.  
  113. proc grep {exp args} {
  114.     set files {}
  115.     foreach arg $args {
  116.     eval lappend files [glob -t TEXT -nocomplain $arg]
  117.     }
  118.     if {![llength $files]} {return "No files matched pattern"}
  119.     set cid [scancontext create]
  120.     scanmatch $cid $exp {
  121.     if {!$blah} {
  122.         set blah 1
  123.         set lines "(<cr> to go to match)\n"
  124.     }
  125.     set l [expr {20 - [string length [file tail $f]]}]
  126.     regsub -all "\t" $matchInfo(line) "  " text
  127.     append lines "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): ${text}\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t░$f\n"
  128.     }
  129.     
  130.     set blah 0
  131.     set lines ""
  132.     
  133.     foreach f $files {
  134.     if {![catch {set fid [open $f]}]} {
  135.         message [file tail $f]
  136.         scanfile $cid $fid
  137.         close $fid
  138.     }
  139.     }
  140.     scancontext delete $cid
  141.     return [string trimright $lines "\r"]
  142. }
  143.  
  144. proc grepnames {exp args} {
  145.     set files {}
  146.     foreach arg $args {
  147.     eval lappend files [glob -t TEXT -nocomplain $arg]
  148.     }
  149.     if {![llength $files]} {return "No files matched pattern"}
  150.     set cid [scancontext create]
  151.     scanmatch $cid $exp {
  152.     lappend filenames $f
  153.     }
  154.     set filenames ""
  155.     foreach f $files {
  156.     if {![catch {set fid [open $f]}]} {
  157.         message [file tail $f]
  158.         scanfile $cid $fid
  159.         close $fid
  160.     }
  161.     }
  162.     scancontext delete $cid
  163.     return $filenames
  164. }
  165.  
  166. ## 
  167.  # -------------------------------------------------------------------------
  168.  # 
  169.  # "grepsToWindow" --
  170.  # 
  171.  #  'args' is a list of items
  172.  # -------------------------------------------------------------------------
  173.  ##
  174. proc grepsToWindow {title args} {
  175.     global tileLeft tileTop tileWidth tileHeight errorHeight
  176.     win::SetProportions
  177.     new -n $title -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  178.       -tabsize 8 -info [join $args ""]
  179.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  180.     message ""
  181. }
  182.  
  183. ## 
  184.  # -------------------------------------------------------------------------
  185.  # 
  186.  # "performSearch" --
  187.  # 
  188.  #  Call this procedure in Tcl code which wants to use the standard procs
  189.  #  like 'replaceAll' to ensure flags like multi-file batch replace are
  190.  #  cleared.  Otherwise replaceAll might not have the desired effect.
  191.  #  
  192.  #  This proc is overridden by code (such as supersearch) which might
  193.  #  otherwise cause the nasty behaviour.
  194.  # -------------------------------------------------------------------------
  195.  ##
  196. proc performSearch {args} {
  197.     eval select [uplevel 1 search $args]
  198. }
  199.  
  200. proc findBatch {forward ignore regexp word pat} {
  201.     matchingLines $pat $forward $ignore $word $regexp 
  202. }
  203.  
  204. ## 
  205.  # -------------------------------------------------------------------------
  206.  #     
  207.  #    "containsSpace"    --
  208.  #    
  209.  #     Does the given    text contain any spaces?  In general we    don't complete
  210.  #     commands which    contain    spaces (although perhaps future    extensions
  211.  #     should    do this: e.g. cycle    through    'string    match',    'string    compare',╔)
  212.  # -------------------------------------------------------------------------
  213.  ##
  214. proc containsSpace { cmd } { return [string match "*\[ \t\]*" $cmd] }
  215. proc containsReturn { cmd } { return [string match "*\[\r\n\]*" $cmd] }
  216.  
  217. ## 
  218.  # -------------------------------------------------------------------------
  219.  #     
  220.  #    "findPatJustBefore"    --
  221.  #    
  222.  #     Utility proc to check whether the first occurrence    of 'findpat'
  223.  #     to    the    left of    'pos' is actually an occurrence    of 'pat'. It can
  224.  #     be    used to    check if we're part    of an '} else {' (see TclelectricLeft)
  225.  #     or    in TeX mode    if we're in    the    argument of    a '\label{'    or '\ref{'
  226.  #     (see smartScripts)    for    example.
  227.  #     
  228.  #     A typical usage has the regexp    'pat' end in '$', so that it must
  229.  #     match all the text    up to 'pos'.  'matchw' can be used to store
  230.  #     the first '()'    pair match in the regexp.
  231.  #     
  232.  #     New: maxlook restricts how far this proc will search.  The default
  233.  #     is only 100 (not the entire file), after all this proc is supposed
  234.  #     to look 'just before'!
  235.  # -------------------------------------------------------------------------
  236.  ##
  237. proc findPatJustBefore { findpat pat {pos ""} {matchw ""} {maxlook 100} } {
  238.     if { $pos == "" } {set pos [getPos] }
  239.     if {[pos::compare $pos == [maxPos]]} { set pos [pos::math $pos - 1]}
  240.     if { $matchw != "" } { upvar $matchw word }
  241.     if {[llength [set res [search -s -n -f 0 -r 1 -l [pos::math $pos - $maxlook] -- "$findpat" $pos]]]} {
  242.     if {[regexp -- "$pat" [getText [lindex $res 0] $pos] dum word]} {
  243.         return [lindex $res 0]
  244.     }
  245.     }
  246.     return
  247. }
  248. # Look for pattern in filename after position afterPos and, if found, 
  249. # open the file quietly and select the pattern
  250. # author Jonathan Guyer
  251. proc selectPatternInFile {filename pattern {afterPos ""}} {
  252.     if {$afterPos == ""} {set afterPos [minPos]}
  253.     set searchResult [searchInFile $filename $pattern 1]
  254.     if {[pos::compare [lindex $searchResult 0] >= $afterPos]} {
  255.     placeBookmark
  256.     file::openQuietly $filename
  257.     eval select $searchResult
  258.     message "press <Ctl .> to return to original cursor position"
  259.     return 1
  260.     } else {
  261.     return 0
  262.     }
  263. }
  264.  
  265. proc text::replace {old new {fwd 1} {pos ""}} {
  266.     if {$pos == ""} {set pos [getPos]}
  267.     set m [search -s -f $fwd -m 0 -r 0 -- $old $pos]
  268.     eval replaceText $m [list $new]
  269. }
  270.  
  271. proc isSelection {} {
  272.     return [pos::compare [getPos] != [selEnd]]
  273. }
  274. proc searchStart {} {
  275.     global search_start
  276.     select [getPos]
  277.     setMark
  278.     if {[catch {goto $search_start}]} {message "No previous search"}
  279. }
  280. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */} }
  281. set {patternLibrary(C++ to C Comments)}        { {//(.*)}    {/* \1 */} }
  282. set {patternLibrary(Space Runs to Tabs)}    { { +}    {\t}}
  283.  
  284. proc getPatternLibrary {} {
  285.     global patternLibrary
  286.     
  287.     foreach nm [array names patternLibrary] {
  288.     lappend nms [concat [list $nm] $patternLibrary($nm)]
  289.     }
  290.     return $nms
  291. }
  292.  
  293. # This fails if, say, search string is '\{[^}]'
  294. # This is because the '}' ends the first argument because this
  295. # procedure is presumably called internally with incorrect quoting.
  296. proc rememberPatternHook {search replace} {
  297.     global patternLibrary modifiedArrayElements
  298.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  299.     return ""
  300.     }
  301.     lappend modifiedArrayElements [list $name patternLibrary]
  302.     set patternLibrary($name) [list $search $replace]
  303.     return $name
  304. }
  305.  
  306. proc deletePatternHook {} {
  307.     global patternLibrary modifiedArrayElements
  308.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  309.     set name [eval [concat $temp [array names patternLibrary]]]
  310.     lappend modifiedArrayElements [list $name patternLibrary]
  311.     unset patternLibrary($name)
  312. }
  313.  
  314. ## 
  315.  # -------------------------------------------------------------------------
  316.  # 
  317.  # "regIsearch" -- REGular expression Iterative SEARCH
  318.  # 
  319.  # This version allows class shorthands (\d \s \w \D \S \W), 
  320.  # word anchors (\b), and some aliases of the machine dependent 
  321.  # control characters (\a \f \e \n \r \t). Therefore, 
  322.  # we need two prompts, one for when we have a valid pattern, and one 
  323.  # for when the pattern has gone invalid (most likely due to starting 
  324.  # to enter one of the above patterns). 
  325.  # 
  326.  # The Return key aborts it  and the point goes back to the 
  327.  # original $pos. You can then use 'exchangePointAndMark' 
  328.  # (cntrl-x, cntrl-x -in emacs keyset) to jump back and forth 
  329.  # between where the search started from, to where the search was
  330.  # ended.
  331.  # 
  332.  # The Escape key or Mouse-click "exits" it, (as does "abortEm" -bound 
  333.  # to cntrl-g), as well as most modifier-key-combinations
  334.  # (except for Shift, and any combination whose  binding's 
  335.  # functionality makes sense -see regComp below). Also the 
  336.  # up & down Arrow keys, exit it. An exit differs from an abort in that, 
  337.  # in the former, the selection is left at the last search result.
  338.  # 
  339.  # 
  340.  # The next occurrence of the current pattern can be matched by typing 
  341.  # either control-s (to get the next occurence forward), or control-r 
  342.  # (to get the the next occurrence backward)
  343.  #
  344.  # Also, after aborting, the search string is left in the Find dialog,
  345.  # and so you can use 'findAgain', but, be aware that the Find dialog
  346.  # starts out with a default of <Grep=OFF>.
  347.  #  
  348.  # Original Author: Mark Nagata
  349.  # modifications  : Tom Fetherston
  350.  # -------------------------------------------------------------------------
  351.  ##
  352. proc regIsearch {} {
  353.     
  354.     set ignoreCase 0
  355.     set patt ""
  356.     set pos [getPos]
  357.     
  358.     set done 0
  359.     while {!$done} {
  360.     # check pattern validatity
  361.     if {[catch {regexp -- $patt {} dmy} dmy]} {        
  362.         set prompt "building->: $patt"
  363.     } else {
  364.         set prompt "regIsearch: $patt"
  365.     } 
  366.     switch -- [catch {status::prompt $prompt regComp "anything"} res] {
  367.         0 {
  368.         # got a keystroke that triggered a normal end (e.g. <return>)
  369.         goto $pos
  370.         message "Aborted: $patt"
  371.         return
  372.         }
  373.         1 {
  374.         # an error was generated
  375.         if {[string match "missing close-brace" $res]} {
  376.             # must have typed a slash, so:
  377.             append patt "\\"
  378.             continue
  379.         } else {
  380.             # alertnote $res
  381.             set done 1
  382.         }
  383.         
  384.         }
  385.         default {
  386.         set done 1
  387.         }
  388.     }
  389.     }
  390.     
  391.     message " Exited: $patt"
  392. }
  393.  
  394.  
  395. ## 
  396.  # -------------------------------------------------------------------------
  397.  # 
  398.  # "regComp" -- REGisearch COMmand line input character Processor
  399.  # 
  400.  #  This proc handles each keypress while running a regIsearch. It has been 
  401.  #  modified from Mark Nagata's original to provide next ocurrence 
  402.  #  before/after current, and support for key bindings whose navigation or 
  403.  #  text manipulation functionality makes sense with respect to a regIsearch.
  404.  #  
  405.  #  closest occurence before current match    
  406.  #    - command-option g & cntrl-r (mnemonic 'reverse')
  407.  #  closest occurence after current match
  408.  #    - command g & cntrl-s (mnemonic 'successor')
  409.  #  
  410.  #                         Text Naviagation
  411.  #  forwardChar (aborts and leaves cursor after last match)
  412.  #    - right arrow & cntrl-f (emacs)
  413.  #  backwardChar (aborts and leaves cursor before last match)
  414.  #    - left arrow & cntrl-b (emacs)
  415.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  416.  #      containing the last match)
  417.  #    - cmd left arrow & cntrl-a (emacs)
  418.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  419.  #      containing the last match)
  420.  #    - cmd right arrow & cntrl-e (emacs)
  421.  #  
  422.  #                         Text Manipulation
  423.  #  deleteSelection (aborts and deletes selection)
  424.  #    - cntrl-d (emacs)
  425.  #  killLine (aborts and deletes from start of selection to end of line)
  426.  #    - cntrl-k (emacs)
  427.  #  
  428.  # -------------------------------------------------------------------------
  429.  ##
  430. proc regComp {curr {key 0} {mod 0}} {
  431.     set direction {}
  432.     
  433.     # build a string that represents all the modifiers pressed:
  434.     # checking in this order cmd, shift, option, and ctrl
  435.     if {[expr {$mod & 1}]} { append t "c" } else { append t "_" }
  436.     if {[expr {$mod & 34}]} { append t "s" } else { append t "_" }
  437.     if {[expr {$mod & 72}]} { append t "o" } else { append t "_" }
  438.     if {[expr {$mod & 144}]} { append t "z" } else { append t "_" }
  439.     
  440.     scan $key %c decVal
  441.     
  442.     switch -- $t {
  443.     "____" {
  444.         switch -- $decVal {
  445.         29 {forwardChar ;         break; # right arrow; }
  446.         28 {backwardChar ;         break; # left arrow; }
  447.         30 {                        break; # up arrow; }
  448.         31 {                        break; # down arrow; }
  449.         }
  450.     }
  451.     }
  452.     
  453.     switch -- $t {
  454.     "____" - 
  455.     "_s__" {
  456.         upvar patt pat
  457.         if {$curr != ""} {
  458.         while {[string compare [string range $pat [string last $curr $pat] end] $curr] != 0} {
  459.             set newEnd [expr {[string length $pat] - 2}]
  460.             if {$newEnd < 0} {
  461.             error "deleted past string start"
  462.             } 
  463.             set pat [string range $pat 0 $newEnd] 
  464.         }
  465.         } 
  466.         
  467.         set preAppend $pat
  468.         append pat $key
  469.         if {[catch {regexp -- $pat {} dmy} res]} {
  470.         message "building->: $preAppend"
  471.         } else {
  472.         message "regIsearch: $preAppend" 
  473.         upvar ignoreCase ign
  474.         set searchResult [search -n -f 1 -m 0 -i $ign -r 1 -- $pat [getPos]]
  475.         if {[llength $searchResult] == 0} {
  476.             beep
  477.         } else {
  478.             select [lindex $searchResult 0] [lindex $searchResult 1]
  479.         }
  480.         } 
  481.         return $key
  482.         
  483.     }
  484.     "c___" {
  485.         switch -- $decVal {
  486.         103 { set direction fwd;        # (cmd g); }
  487.         28 {beginningOfLine ;     break; # cmd left arrow; }
  488.         29 {endOfLine ;         break; # cmd right arrow; }
  489.         }
  490.         
  491.     }
  492.     "___z" {
  493.         # If the user is using the emacs key bindings, check for ones that 
  494.         # make sense. All other control key combinations abort
  495.         if {[package::active emacs]} {
  496.         switch -- $decVal {
  497.             6 {forwardChar ;         break; # cntrl-f; }
  498.             2 {backwardChar ;     break; # cntrl-b; }
  499.             1 {beginningOfLine ;     break; # cntrl-a; }
  500.             5 {endOfLine ;         break; # cntrl-e; }
  501.             4 {deleteSelection ;     break; # cntrl-d; }
  502.             10 {killLine ;         break; # cntrl-k; }
  503.         }
  504.         } 
  505.         # See if user has requested to find another match, either searchForward 
  506.         # (cntrl-s) or reverseSearch (cntrl-r). Set flag accordingly
  507.         switch -- $decVal {
  508.         115 - 19 { set direction fwd; # (cntrl-s); }
  509.         114 - 18 { set direction bckwd; # (cntrl-r); }
  510.         default {return {} }
  511.         }
  512.     }
  513.     "c_o_" {
  514.         switch -- $decVal {
  515.         169 { set direction bckwd; # (cmd-opt 'g'); }
  516.         default {return {} }
  517.         }
  518.         
  519.     }
  520.     "default" {
  521.         beep
  522.         error "modifier combination has no meaningful bindings with respect to regIsearch"
  523.     }
  524.     }
  525.     # handle direction flag if it got set above
  526.     if {$direction != ""} {
  527.     upvar patt pat
  528.     upvar ignoreCase ign
  529.     if {[string match $direction fwd]} {
  530.         set dir 1
  531.         set search_start [pos::math [getPos] + 1]
  532.     } else {
  533.         set dir 0
  534.         set search_start [pos::math [getPos] - 1]
  535.     } 
  536.     set searchResult [search -n -f $dir -m 0 -i $ign -r 1 -- $pat $search_start]
  537.     if {[llength $searchResult] == 0} {
  538.         beep
  539.     } else {
  540.         select [lindex $searchResult 0] [lindex $searchResult 1]
  541.     }
  542.     return {}
  543.     } 
  544. }
  545.  
  546.  
  547. proc choicesProc {curr c} {
  548.     global choiceList
  549.     if {$c != "\t"} {return $c}
  550.     
  551.     set matches {}
  552.     foreach w $choiceList {
  553.     if {[string match "$curr*" $w]} {
  554.         lappend matches $w
  555.     }
  556.     }
  557.     if {![llength $matches]} {
  558.     beep
  559.     } else {
  560.     return [string range [largestPrefix $matches] [string length $curr] end]
  561.     }
  562.     return ""
  563. }
  564.  
  565.  
  566. proc sPromptChoices {msg def choiceListIn} {
  567.     global useStatusBar choiceList
  568.     set choiceList $choiceListIn
  569.     if {[catch {statusPrompt -f "$msg ($def): " choicesProc} ans]} {
  570.     error "cancel"
  571.     }
  572.     if {![string length $ans]} {return $def}
  573.     return $ans
  574. }
  575.  
  576. proc nextFunc {} {
  577.     searchFunc 1
  578. }
  579.  
  580. proc prevFunc {} {
  581.     searchFunc 0
  582. }
  583.  
  584. proc jumpNextFunc {} {
  585.     searchFunc 3
  586. }
  587.  
  588. proc jumpPrevFunc {} {
  589.     searchFunc 2
  590. }
  591.  
  592. proc searchFunc {code} {
  593.     set pos [getPos]
  594.     
  595.     #to allow us to handle special cases
  596.     set funcExpr [get_funcExpr $code]
  597.     
  598.     select $pos
  599.     
  600.     switch -- $code {
  601.     "1" -
  602.     "3" {
  603.         set pos [pos::math $pos + 1]
  604.         set lastStop [maxPos]
  605.         set dir 1
  606.     }
  607.     "0" -
  608.     "2" {
  609.         set pos [pos::math $pos - 1]
  610.         set lastStop [minPos]
  611.         set dir 0
  612.     }
  613.     }
  614.     
  615.     if {![catch {search -s -f $dir -i 1 -r 1 -- $funcExpr $pos} res]} {
  616.     eval select $res
  617.     } elseif {$code == 3} {
  618.     searchFunc 1
  619.     } else {
  620.     goto $lastStop
  621.     if {$dir} {
  622.         message "At bottom, no more functions in this direction"
  623.     } else {
  624.         message "At top, no more functions in this direction"
  625.     }
  626.     }
  627. }
  628.  
  629. proc get_funcExpr {dir} {
  630.     global funcExpr mode
  631.     switch -- $mode {
  632.     "Tcl" {
  633.         if {[regexp "^\\* Trace" [win::CurrentTail]]} {
  634.         switch $dir {
  635.             "0" -
  636.             "1" {
  637.             set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  638.             }
  639.             "2" {
  640.             if {[regexp {(^.*)OK:} [getSelect] blah searchExpr]} {
  641.                 set searchExpr "^${searchExpr}"
  642.             } else {
  643.                 set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  644.             }
  645.             }
  646.             "3" {
  647.             regexp {(^[^']*)'?} [getSelect] blah searchExpr
  648.             set searchExpr "^${searchExpr}OK:"
  649.             }
  650.         }
  651.         } else {
  652.         set searchExpr $funcExpr 
  653.         } 
  654.     }
  655.     default {
  656.         set searchExpr $funcExpr 
  657.     }
  658.     }
  659.     return $searchExpr     
  660. }
  661.  
  662. proc sPrompt {msg def} {
  663.     global useStatusBar
  664.     if {!$useStatusBar} {return [prompt $msg $def]}
  665.     if {[catch {statusPrompt "$msg ($def): "} ans]} {
  666.     error "cancel"
  667.     }
  668.     if {![string length $ans]} {return $def}
  669.     return $ans
  670. }
  671.  
  672. ###
  673. #===========================================================================
  674. # Juan Falgueras (7/Abril/93)
  675. # you only need to select (or not) text and move *forward and backward*
  676. # faster than iSearch (if you have there the |word wo|rd..).
  677. #===========================================================================
  678.  
  679. proc quickSearch {dir} {
  680.     if {[pos::compare [selEnd] == [getPos]]} {
  681.     backwardChar
  682.     hiliteWord
  683.     }
  684.     set myPos [expr {$dir ? [selEnd] : [pos::math [getPos] - 1]}]
  685.     set text [getSelect]
  686.     set searchResult [search -s -n -f $dir -m 0 -i 1 -r 0 $text $myPos]
  687.     if {[llength $searchResult] == 0} {
  688.     beep
  689.     message [concat [expr {$dir ? "->" : "<-"}] '$text' " not found"]
  690.     return 0
  691.     } else {
  692.     message [concat [expr {$dir ? "->" : "<-"}] '$text']
  693.     eval select $searchResult
  694.     return 1
  695.     }
  696. }
  697.  
  698.